home *** CD-ROM | disk | FTP | other *** search
/ The Best of MacTutor - S…e Code for Volumes 1 to 5 / The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin / Source Code / #45 (Jun 89) / Splitbar Test ƒ / CDEF ƒ / splitbar.pas < prev    next >
Pascal/Delphi Source File  |  1989-03-28  |  8KB  |  249 lines
  1. unit MyControl;
  2. {Splitbar Code Definition Function - ID=17}
  3. {This creates to types of splitbar controls - horizontal, variation code 1; and vertical, variation code 2}
  4. {A Splitbar is essentially just an indicator (thumb) which can be moved by the mouse to set }
  5. {up window panes.  The control only moves the thumb.  It is up to the application to create/resize normal}
  6. {scrollbars, adjust the content region, and so forth.  It will only return the Indicator part code of}
  7. {inThumb (129).  There are no page/line up/down parts}
  8. {valid min is 0 and max is screen width - indicatorwidth; control value is then in pixels}
  9. {To get a horizontal splitbar ask for CDEF 273 ( 16*ID + variation), and 274 for vertical}
  10. {History}
  11. {3/15/89 Created by Kirk Chase}
  12.  
  13. interface
  14.     { main entry into CDEF }
  15.     function main (varCode: integer; theControl: ControlHandle; message: integer; param: longint): longint;
  16.  
  17. implementation
  18.     const
  19.         vSplitBar = 2; {Variation code for a vertical splitbar}
  20.         hSplitBar = 1; {Variation code for a horizontal splitbar}
  21.         IndicatorWidth = 6; {width of thumb}
  22.         PaneWidth = 4;
  23.         draw = 1;
  24.         erase = 0;
  25.         invisible = 0;
  26.         inactive = 255;
  27.  
  28.     function main;
  29.  
  30.         procedure doRect (varcode, value: integer; var theRect: rect);
  31.     {calculate indicator rectangle according to varcode}
  32.         begin
  33.     {actual drawing of thumb is as follows for a horizontal splitbar - it is similar for a vertical one}
  34.     { top := top of control + 1}
  35.     {bottom := bottom of control -1}
  36.     {left := value of control + left of control}
  37.     {right := left + indicator width}
  38.             case varcode of
  39.                 vSplitBar: 
  40.                     begin
  41.                         theRect.top := value + theRect.top;
  42.                         theRect.bottom := theRect.top + IndicatorWidth;
  43.                         InsetRect(theRect, 1, 0);
  44.                     end;
  45.                 hSplitBar: 
  46.                     begin
  47.                         theRect.left := value + theRect.left;
  48.                         theRect.right := theRect.left + IndicatorWidth;
  49.                         InsetRect(theRect, 0, 1);
  50.                     end;
  51.             end;
  52.         end;
  53.  
  54.         procedure doInit (myControl: ControlHandle);
  55.     {initializes the control by storing the thumb region and setting the action proc to nil}
  56.         begin
  57.             myControl^^.contrlAction := nil; {set action proc - no default proc.}
  58.         end; {of doInit}
  59.  
  60.         procedure doDraw (varCode: integer; myControl: ControlHandle; flag: integer);
  61.     {this will draw or erase the thumb control according to flag}
  62.             var
  63.                 aRect, iRect: Rect;
  64.                 oldClip, controlRegion: RgnHandle;
  65.                 oldPen: PenState;
  66.         begin
  67.       {only draw if visible}
  68.             if (myControl^^.contrlVis <> invisible) then
  69.                 begin
  70.            { Get the control's region and set the clip region to that region.  }
  71.                     oldClip := NewRgn;
  72.                     GetClip(oldClip);
  73.  
  74.              { Set the clip region to the control's rectangle }
  75.                     aRect := myControl^^.contrlRect;
  76.                     iRect := aRect;
  77.                     controlRegion := NewRgn;
  78.                     RectRgn(controlRegion, aRect);
  79.                     MoveHHi(Handle(myControl));
  80.                     HLock(Handle(myControl));
  81.                     SetClip(controlRegion);
  82.                     HUnlock(Handle(myControl));
  83.  
  84.           {set pen to normal state}
  85.                     GetPenState(oldPen);
  86.                     PenNormal;
  87.  
  88.                     FrameRect(aRect); {draw control bounds}
  89.  
  90.                     doRect(varcode, myControl^^.contrlValue, iRect); {get indicator}
  91.  
  92.           {either draw or erase indicator}
  93.                     if flag = draw then
  94.                         PaintRect(iRect)
  95.                     else
  96.                         EraseRect(iRect);
  97.  
  98.                     if (myControl^^.contrlHilite = inactive) then
  99.                         EraseRect(iRect); {inactive controls}
  100.  
  101.                     SetClip(oldClip); {Clean up}
  102.                     DisposeRgn(oldClip);
  103.                     DisposeRgn(controlRegion);
  104.                     SetPenState(oldPen);
  105.                 end;
  106.         end; {of doDraw}
  107.  
  108.         function doTest (varcode: integer; myControl: ControlHandle; theParam: longint): longint;
  109.     {returns inThumb or 0 if mousedown in thumb or not}
  110.             var
  111.                 CRect, IRect: Rect;
  112.                 thePoint: point;
  113.         begin
  114.             CRect := myControl^^.contrlRect; {initialize values}
  115.             IRect := CRect;
  116.             thePoint := point(theParam);
  117.             doTest := 0;
  118.  
  119.     {test point if active and visible}
  120.             if (myControl^^.contrlHilite <> inactive) and (myControl^^.contrlVis <> invisible) then
  121.                 begin
  122.         {in control?}
  123.                     if PtInRect(thePoint, CRect) then
  124.                         begin
  125.             {in thumb?}
  126.                             doRect(varcode, myControl^^.contrlValue, IRect); {get indicator}
  127.                             if PtInRect(thePoint, IRect) then
  128.                                 doTest := inThumb;
  129.                         end;
  130.                 end;
  131.         end; {of doTest}
  132.  
  133.         procedure doCalc (varcode: integer; myControl: ControlHandle; theParam: longint);
  134.     {calculate all or indicator's region}
  135.             var
  136.                 aRect: Rect;
  137.                 thumbRgn: RgnHandle;
  138.         begin
  139.        { CalcButtnRgn must first find out of the high bit is set.          }
  140.        { High bit set indicates that the region being calculated is for     }
  141.        { an indicator                            }
  142.             if not BitTst(Ptr(@theParam), 0) then
  143.                 begin {whole region}
  144.                     theParam := longint(BitAnd(theParam, $00FFFFFF));
  145.                     aRect := myControl^^.contrlRect;
  146.                     RectRgn(RgnHandle(theParam), aRect);
  147.                 end
  148.             else
  149.                 begin
  150.                     aRect := myControl^^.contrlRect;     {get thumb region}
  151.                     doRect(varcode, myControl^^.contrlValue, aRect); {get indicator}
  152.                     thumbRgn := NewRgn;
  153.                     RectRgn(thumbRgn, aRect);
  154.                     if varcode = vSplitBar then {get region across screen}
  155.                         SetRect(aRect, 0, aRect.top + 1, aRect.right, aRect.bottom - 1) {vertical splitbar}
  156.                     else
  157.                         SetRect(aRect, aRect.left + 1, 0, aRect.right - 1, aRect.top); {horizontal splitbar}
  158.                     RectRgn(RgnHandle(theParam), aRect);
  159.                     UnionRgn(RgnHandle(theParam), thumbRgn, RgnHandle(theParam));
  160.                     DisposeRgn(thumbRgn);
  161.                 end;
  162.         end; {of doCalc}
  163.  
  164.         procedure doThumb (myControl: ControlHandle; varcode: integer; theParam: longint);
  165.     {this sets up dragging parameters for thumb}
  166.             type
  167.                 thumbPtr = ^thumbinfo;
  168.                 thumbinfo = record
  169.                         limitRect: Rect;
  170.                         trackRect: Rect;
  171.                         axis: integer;
  172.                     end;
  173.         begin
  174.             with thumbPtr(theParam)^ do
  175.                 begin
  176.                     limitRect := myControl^^.contrlRect;
  177.                     trackRect := myControl^^.contrlRect;
  178.                     axis := varcode;
  179.                 end;
  180.         end; {of doThumb}
  181.  
  182.         procedure doPosition (myControl: ControlHandle; varcode: integer; DeltaPoint: longint);
  183.     {this routine is called to reposition the control }
  184.     {first erase old position of control and draw in new place}
  185.             var
  186.                 thePoint: point;
  187.                 value, delta, position: integer;
  188.                 aRect: rect;
  189.         begin
  190.             aRect := myControl^^.contrlRect;     {get thumb region}
  191.             doRect(varcode, myControl^^.contrlValue, aRect); {get indicator}
  192.             InvalRect(aRect);
  193.             doDraw(varCode, myControl, erase); {erase}
  194.  
  195.             thePoint := point(DeltaPoint);
  196.             value := myControl^^.contrlValue;
  197.  
  198.             if varcode = vSplitBar then {calculate delta offset}
  199.                 begin
  200.                     position := value + thePoint.v;
  201.                     delta := thePoint.v;
  202.                 end
  203.             else
  204.                 begin
  205.                     position := value + thePoint.h;
  206.                     delta := thePoint.h;
  207.                 end;
  208.  
  209.     {recalculate delta offset if out of bounds}
  210.             if position < myControl^^.contrlMin then
  211.                 delta := -(value - myControl^^.contrlMin);
  212.             if position > myControl^^.contrlMax then
  213.                 delta := myControl^^.contrlMax - value;
  214.  
  215.             myControl^^.contrlValue := myControl^^.contrlValue + delta; {reset control value}
  216.  
  217.             doDraw(varCode, myControl, draw); {redraw}
  218.         end; {of doPosition}
  219.  
  220.     begin {main entry point}
  221.         main := 0; {initialize values}
  222.         case message of {switch to proper routine}
  223.             initCntl: 
  224.                 doInit(theControl);
  225.  
  226.             drawCntl: 
  227.                 doDraw(varCode, theControl, draw);
  228.  
  229.             testCntl: 
  230.                 main := doTest(varcode, theControl, param);
  231.  
  232.        { Calc the region for the button. }
  233.             calcCRgns: 
  234.                 doCalc(varcode, theControl, param);
  235.  
  236.             thumbCntl: 
  237.                 doThumb(theControl, varcode, param);
  238.  
  239.             posCntl: 
  240.                 doPosition(theControl, varcode, param);
  241.  
  242.        { Nothing to do for these messages... }
  243.             dragCntl, autoTrack, dispCntl: 
  244.                 ;
  245.             otherwise
  246.         end;
  247.     end;
  248.  
  249. end. {of MyControl Unit}